home *** CD-ROM | disk | FTP | other *** search
- unit sdd; {string device driver to convert numbers and parse strings}
-
- interface
-
- uses SysUtils;
-
- procedure AssignSt(var t:textFile;var s:string);
- procedure delim(var s:string;c:char;undo:boolean);
-
- implementation
-
- type
- PString=^string;
- usr=record
- ps : PString;
- ud : array[5..16] of byte;
- end;
-
- function InStr(var t:textFile):integer; far;
- begin
- Result := 0; {for ioResult}
- with TTextRec(t),usr(UserData) do
- begin
- if (BufPos<BufEnd) and (Handle<>0) then exit;
- BufPos := 0;
- BufEnd := length(ps^)-Handle;
- if BufEnd>BufSize then BufEnd := BufSize;
- move(ps^[succ(Handle)],BufPtr^,BufEnd);
- inc(Handle,BufEnd);
- end;
- end; {InStr}
-
- function OutStr(var t:textFile):integer; far;
- var
- i : integer;
- begin
- with TTextRec(t),usr(UserData) do
- begin
- for i := BufEnd to BufPos-1 do ps^ := ps^+BufPtr^[i];
- Handle := length(ps^);
- BufEnd := BufPos;
- end; {with}
- Result := 0; {for ioResult}
- end; {OutStr}
-
- function FlushStr(var t:textFile):integer; far;
- begin
- Result := 0; {for ioResult}
- end; {FlushStr}
-
- function CloseStr(var t:textFile):integer; far;
- begin
- with TTextRec(t) do
- begin
- Mode := fmClosed;
- Handle := 0;
- end;
- Result := 0; {for ioResult}
- end; {CloseStr}
-
- function OpenStr(var t:textFile):integer; far;
- begin
- with TTextRec(t),usr(UserData) do
- begin
- CloseFunc := @CloseStr;
- case Mode of
- fmInOut : begin
- Mode := fmOutput;
- InOutFunc := @OutStr;
- FlushFunc := @OutStr;
- Handle := length(ps^);
- end;
- fmInput : begin
- InOutFunc := @InStr;
- FlushFunc := @FlushStr;
- end;
- fmOutput : begin
- InOutFunc := @OutStr;
- FlushFunc := @OutStr;
- ps^ := '';
- end;
- end; {case}
- end; {with}
- Result := 0; {for ioResult}
- end; {OpenStr}
-
- procedure AssignSt(var t:textFile;var s:string);
- begin
- with TTextRec(t),usr(UserData) do
- begin
- Mode := fmClosed;
- BufSize := SizeOf(buffer);
- BufPtr := @buffer;
- OpenFunc := @OpenStr;
- Name[0] := #0;
- ps := @s;
- Handle := 0;
- end; {with}
- end; {AssignSt}
-
- procedure delim(var s:string;c:char;undo:boolean); assembler;
- asm
- {point to the string}
- {with es:di and put its}
- {length into cx}
- les di,s
- mov cl,es:di.0
- {bail out if null string}
- or cl,cl
- jz @@2
- xor ch,ch
- {search direction forward}
- cld
- {make sure length byte not tested}
- inc di
-
- {set up the comparison}
- mov al,c
- mov ah,13
- mov bl,undo
- or bl,bl
- {leave normal if undo false}
- {c will become #13}
- jz @@1
- {restore if undo}
- {#13 will become c}
- xchg al,ah
-
- @@1:
- {search until match found}
- repnz scasb
- {if no match here then done}
- {got here by reading end}
- jnz @@2
- {substitute the found char}
- mov es:di.-1,ah
- {check for found and at end}
- {at the same time}
- or cl,cl
- jz @@2
- {look for next match}
- jmp @@1
-
- @@2:
- end;
-
- end.
-